unit TMD.HookWinControl;

{ 本单元内容截选自 orpheus.o32vlop1.pas by 推云童子 }

{$mode objfpc}{$H+}

interface

uses
  Windows, LclIntf, LclType,
  Controls, Classes, Forms, SysUtils;

type
  PWndMethod = ^TWndMethod;
  PWndProc = ^TWndProc;
  TWndProc = function(hWnd: HWND; Msg: UINT; wParam: WPARAM;
    lParam: LPARAM): LRESULT;{$IFDEF MSWINDOWS} stdcall; {$ELSE} cdecl;{$ENDIF}

function Hook(const aWinControl: TWinControl; aNewWndMethod: TWndMethod;
  var aPrevWndProc: PWndProc): boolean;
function UnHook(const aWinControl: TWinControl;
  var aPrevWndProc: TWndProc): boolean;

implementation

function TMDLclWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
          {$IFDEF MSWINDOWS} stdcall; {$ELSE} cdecl;
{$ENDIF}
var
  AMsg: TMessage;
  MethodPtr: PWndMethod;
begin
  FillChar(AMsg, SizeOf(Msg), #0);
  AMsg.Msg := Msg;
  AMsg.WParam := wParam;
  AMsg.LParam := lParam;
  MethodPtr := Pointer(GetWindowLong(hWnd, GWL_USERDATA));

  if Assigned(MethodPtr) then
    MethodPtr^(AMsg);
end;

function Hook(const aWinControl: TWinControl; aNewWndMethod: TWndMethod;
  var aPrevWndProc: PWndProc): boolean;
var
  LMethodPtr: PWndMethod;
begin
  Result := False;
  if not Assigned(aWinControl) then
    exit;
  if not aWinControl.HandleAllocated then
    aWinControl.HandleNeeded;

  aPrevWndProc := Pointer(GetWindowLong(aWinControl.Handle, GWL_WNDPROC));
  if integer(aPrevWndProc) = integer(@TMDLclWndProc) then
    exit;

  GetMem(LMethodPtr, SizeOf(TMethod));
  LMethodPtr^ := aNewWndMethod;

  SetWindowLong(aWinControl.Handle, GWL_USERDATA, PtrInt(LMethodPtr));
  if not Assigned(Pointer(GetWindowLong(aWinControl.Handle, GWL_USERDATA))) then
  begin
    FreeMem(LMethodPtr);
    exit;
  end;

  SetWindowLong(aWinControl.Handle, GWL_WNDPROC, LPARAM(@TMDLclWndProc));
  Result := True;
end;

function UnHook(const aWinControl: TWinControl;
  var aPrevWndProc: TWndProc): boolean;
var
  MethodPtr: PWndMethod;
begin
  Result := False;
  if not Assigned(aPrevWndProc) then
    exit;
  if not Assigned(aWinControl) then
    exit;
  if not aWinControl.HandleAllocated then
    exit;

  MethodPtr := PWndMethod(Pointer(GetWindowLong(aWinControl.Handle, GWL_USERDATA)));
  if Assigned(MethodPtr) then
    Freemem(MethodPtr);

  SetWindowLong(aWinControl.Handle, GWL_WNDPROC, LPARAM(Pointer(aPrevWndProc)));
  aPrevWndProc := nil;
  Result := True;
end;

end.
